home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / 3d2split / 3d2.bas next >
BASIC Source File  |  1995-09-06  |  20KB  |  473 lines
  1. '----------------------------------------------------------
  2. '| 3D Routines with Splitter Bars v2.0 - By Daniel Benito |
  3. '----------------------------------------------------------
  4. '
  5. ' This file contains a new version of a minute collection of simple
  6. ' routines that enable you to paint several kinds of frames around or
  7. ' inside controls and forms, adding a 3D effect to your application,
  8. ' without the need of .VBX controls or .DLLs.
  9. '
  10. ' They were written to cover a basic need, while keeping code
  11. ' simple and fast.
  12. '
  13. ' The idea of these subroutines is loosely based on a routine called
  14. ' Outlines, which is included in the VB 3.0 sample application
  15. ' VISDATA.
  16. '
  17. ' Also included is DrawOutline, a routine used with my splitter bars.
  18. '
  19. ' The author spent a while coding these routines. If you find them useful,
  20. ' he would gratefully accept ten bucks (sic), five quid, mil quinientas pelas,
  21. ' or whatever you consider adequate in your currency.
  22. '
  23. ' My postal address is:
  24. '
  25. '     Daniel Benito
  26. '     Soto Hidalgo, 8
  27. '     28042 Madrid (Spain)
  28. '
  29. ' If you have any questions, send me a message to the CIS address
  30. ' 100022,141, or post it in the MSBASIC forum.
  31.  
  32. ' 3D constants
  33. Global Const INSET = -1
  34. Global Const RAISED = 0
  35. Global Const REMOVE = 2
  36.  
  37. ' WindowState
  38. Global Const NORMAL = 0
  39. Global Const MINI = 1
  40. Global Const MAXI = 2
  41.  
  42. ' Colors
  43. Global Const BLACK = &H0&
  44. Global Const RED = &HFF&
  45. Global Const GREEN = &HFF00&
  46. Global Const YELLOW = &HFFFF&
  47. Global Const BLUE = &HFF0000
  48. Global Const MAGENTA = &HFF00FF
  49. Global Const CYAN = &HFFFF00
  50. Global Const WHITE = &HFFFFFF
  51. Global Const LIGHTGRAY = &HC0C0C0
  52. Global Const DARKGRAY = &H808080
  53.  
  54. Declare Sub DrawFocusRect Lib "User" (ByVal hDC%, lpRect As Any)
  55. Declare Sub GetWindowRect Lib "User" (ByVal hWnd%, lpRect As Any)
  56. Declare Function GetDC Lib "User" (ByVal hWnd As Integer) As Integer
  57. Declare Function ReleaseDC Lib "User" (ByVal hWnd As Integer, ByVal hDC As Integer) As Integer
  58.  
  59. Type RECT
  60.     Left As Integer
  61.     Top As Integer
  62.     right As Integer
  63.     bottom As Integer
  64. End Type
  65.  
  66. Sub CenterForm (form_name As Form)
  67.     ' Centers form_name on the screen
  68.     Screen.MousePointer = 11
  69.     form_name.Top = Screen.Height / 2 - form_name.Height / 2
  70.     form_name.Left = Screen.Width / 2 - form_name.Width / 2
  71.     Screen.MousePointer = 0
  72. End Sub
  73.  
  74. Sub DrawOutline (rt As RECT, frm As Form)
  75.  
  76. ' This subroutine paints a focus frame at the specified co-ordinates. In this example it is
  77. ' used to draw the marquee that is dragged when you drag an splitter bar.
  78. ' Note: It paints the box on screen DC, not just on the form, to make it appear above other
  79. ' controls.
  80. ' Parameters:
  81. ' rt            - The name of the rect type structure containing the coords of the box to
  82. '                 be drawn.
  83. ' frm           - The form on which to draw the frame.
  84.     
  85.     Dim wndcoord As RECT, r As RECT ' structs used for coords
  86.     Dim Dummy As Integer
  87.     DC = GetDC(0) ' Get the Device Context of the whole screen
  88.     GetWindowRect frm.hWnd, wndcoord ' Get coords of form
  89.     
  90.     ' Add pixels for border and titlebar (the coords of a form in VB do not include them)
  91.     ' The number of pixels to be added depends on the type of border
  92.  
  93.     r.Left = (rt.Left / Screen.TwipsPerPixelX) + wndcoord.Left + 1 '+ 4 sizable border
  94.     r.Top = (rt.Top / Screen.TwipsPerPixelX) + wndcoord.Top + 28 '+ 31 sizable border
  95.     r.right = (rt.right / Screen.TwipsPerPixelX) + wndcoord.Left + 1 '+ 4 sizable border
  96.     r.bottom = (rt.bottom / Screen.TwipsPerPixelX) + wndcoord.Top + 28 '+ 31 sizable border
  97.     
  98.     DrawFocusRect DC, r ' Draw the frame itself
  99.     
  100.     Dummy = ReleaseDC(0, DC) ' Release the allocated DC
  101.  
  102. End Sub
  103.  
  104. Sub InLinePic (pic_name As Control, bevel_size As Integer, dn As Integer)
  105.  
  106. ' This subroutine paints a frame inside a picture box (or any control with
  107. ' the Line method), giving it a 3D effect.
  108. '
  109. ' Parameters:
  110. ' pic_name      - The name of the picture box on which the frame is to be drawn.
  111. ' bevel_size    - Width of the bevel, in pixels.
  112. ' dn            - Indicates the style of the frame:
  113. '                   INSET   - The frame is drawn sunken.
  114. '                   RAISED  - The frame is drawn raised.
  115. '                   REMOVE  - The frame is removed (drawn in light gray).
  116.  
  117.     Dim col1 As Long, col2 As Long ' variables for highlight and shadow colors
  118.     Dim x1 As Integer, y1 As Integer, x As Integer, y As Integer, i As Integer
  119.     Dim pleft As Integer, pright As Integer, ptop As Integer, pbottom As Integer ' coords
  120.     
  121.     Select Case dn ' assign colors depending on frame style
  122.         Case True ' Inset
  123.             col1 = DARKGRAY
  124.             col2 = WHITE
  125.             'col1 = RGB(128, 128, 128) ' Dark gray
  126.             'col2 = RGB(255, 255, 255) ' Bright white
  127.         Case False ' Raised
  128.             col1 = WHITE
  129.             col2 = DARKGRAY
  130.             'col1 = RGB(255, 255, 255) ' Bright white
  131.             'col2 = RGB(128, 128, 128) ' Dark gray
  132.         Case 2 ' Remove
  133.             col1 = LIGHTGRAY
  134.             col2 = LIGHTGRAY
  135.             'col1 = RGB(192, 192, 192) ' Light gray
  136.             'col2 = RGB(192, 192, 192) ' Light gray
  137.         Case Else ' Otherwise, it's an error
  138.             Exit Sub ' Exit subroutine
  139.     End Select
  140.     
  141.     x1 = Screen.TwipsPerPixelX ' Number of twips per pixel horizontally
  142.     y1 = Screen.TwipsPerPixelY ' Number of twips per pixel vertically
  143.     
  144.     bevel_size = bevel_size - 1
  145.     
  146.     pleft = pic_name.ScaleLeft ' Assign coords
  147.     ptop = pic_name.ScaleTop
  148.     pright = pic_name.ScaleLeft + pic_name.ScaleWidth - x1 ' Take away one pixel
  149.     pbottom = pic_name.ScaleTop + pic_name.ScaleHeight - y1 ' Take away one pixel
  150.     
  151.     For i = 0 To bevel_size ' Loop depends of bevel size - draws one rectangle per bevel pixel
  152.         x = x1 * i ' Distance from picture edge
  153.         y = y1 * i ' Distance form picture edge
  154.         pic_name.Line (pleft + x, ptop + y)-(pright - x, ptop + y), col1 ' Draw the individual lines
  155.         pic_name.Line (pleft + x, ptop + y)-(pleft + x, pbottom - y), col1
  156.         pic_name.Line (pleft + x1 + x, pbottom - y)-(pright - x, pbottom - y), col2
  157.         pic_name.Line (pright - x, pbottom - y)-(pright - x, ptop + y), col2
  158.     Next i
  159.  
  160. End Sub
  161.  
  162. Sub OutlineControl (form_name As Form, ctrl_name As Control, bevel_size As Integer, dn As Integer)
  163.     
  164. ' This subroutine paints a frame on a form around a control, giving it a 3D effect.
  165. '
  166. ' Parameters:
  167. ' form_name     - The name of the form on which the control is.
  168. ' ctrl_name     - The name of the control around which the bevel is to be drawn.
  169. ' bevel_size    - Width of the bevel, in pixels.
  170. ' dn            - Indicates the style of the frame:
  171. '                   INSET   - The frame is drawn sunken.
  172. '                   RAISED  - The frame is drawn raised.
  173. '                   REMOVE  - The frame is removed (drawn in light gray).
  174.     
  175.     Dim col1 As Long, col2 As Long ' variables for highlight and shadow colors
  176.     Dim x1 As Integer, y1 As Integer, x As Integer, y As Integer, i As Integer
  177.     Dim cleft As Integer, cright As Integer, ctop As Integer, cbottom As Integer ' coords
  178.     
  179.     Select Case dn ' assign colors depending on frame style
  180.         Case True ' Inset
  181.             col1 = DARKGRAY
  182.             col2 = WHITE
  183.             'col1 = RGB(128, 128, 128) ' Dark gray
  184.             'col2 = RGB(255, 255, 255) ' Bright white
  185.         Case False ' Raised
  186.             col1 = WHITE
  187.             col2 = DARKGRAY
  188.             'col1 = RGB(255, 255, 255) ' Bright white
  189.             'col2 = RGB(128, 128, 128) ' Dark gray
  190.         Case 2 ' Remove
  191.             col1 = LIGHTGRAY
  192.             col2 = LIGHTGRAY
  193.             'col1 = RGB(192, 192, 192) ' Light gray
  194.             'col2 = RGB(192, 192, 192) ' Light gray
  195.         Case Else ' Otherwise, it's an error
  196.             Exit Sub ' Exit subroutine
  197.     End Select
  198.     
  199.     x1 = Screen.TwipsPerPixelX ' Number of twips per pixel horizontally
  200.     y1 = Screen.TwipsPerPixelY ' Number of twips per pixel vertically
  201.     
  202.     bevel_size = bevel_size - 1
  203.     
  204.     cleft